home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib10.dsk / SCREEN BUILDING SUBROUTINE.bas < prev    next >
BASIC Source File  |  2023-02-26  |  6KB  |  171 lines
  1. 1  REM  *****************************
  2. 2  REM  *  SCREEN BUILDING DEMO     *
  3. 3  REM  *  BY E. STEPHEN FREEMAN    *
  4. 4  REM  *   COPYRIGHT (C) 1982      *
  5. 5  REM  *   BY MICRO-SPARC INC      *
  6. 6  REM  *   LINCOLN, MA. 01773      *
  7. 7  REM  *   ALL RIGHTS RESERVED     *
  8. 8  REM  *****************************
  9. 100  DIM T1$(25),T2$(25),T3$(25),T4$(25),T5$(25),T6$(25),T7$(25),T8$(25),T9$(25),TA$(25)
  10. 110  DIM ZA$(25),ZD(25),ZI(25),ZJ(25),ZK$(25),ZE(25),ZH$(25),ZL$(25),ZF$(25),ZQ$(25),ZW$(25),ZX(25)
  11. 120 IX = 1
  12. 130  HOME : VTAB 23: INPUT "NEXT SCREEN # ( 01, 02, 03 ETC.)";X$
  13. 140 ZB$ = "SCREEN#" +X$
  14. 150  GOSUB 60000
  15. 160  IF ZP = 1 GOTO 130
  16. 170 T1$(IX) = ZQ$(1)
  17. 180 T2$(IX) = ZQ$(2)
  18. 190 T3$(IX) = ZQ$(3)
  19. 200 T4$(IX) = ZQ$(4)
  20. 210 T5$(IX) = ZQ$(5)
  21. 220 T6$(IX) = ZQ$(6)
  22. 230 T7$(IX) = ZQ$(7)
  23. 240 T8$(IX) = ZQ$(8)
  24. 250 T9$(IX) = ZQ$(9)
  25. 260 TA$(IX) = ZQ$(10)
  26. 270  HOME : VTAB 23: INPUT "NEXT SCREEN NUMBER  OR  F)INISHED? ";X$
  27. 280  IF X$ = "F"  THEN  GOTO 310
  28. 290 IX = IX +1
  29. 300  GOTO 140
  30. 310  HOME : FOR K = 1 TO IX
  31. 320  PRINT T1$(K)
  32. 330  PRINT T2$(K)
  33. 340  PRINT T3$(K)
  34. 350  PRINT T4$(K)
  35. 360  PRINT T5$(K)
  36. 370  PRINT T6$(K)
  37. 380  PRINT T7$(K)
  38. 390  PRINT T8$(K)
  39. 400  PRINT T9$(K)
  40. 410  PRINT TA$(K)
  41. 420  NEXT K
  42. 430  END 
  43. 440  DATA  "SCREEN#0304"
  44. 450  DATA  "H1000TEST SCREEN # THREE"
  45. 460  DATA  "D1310042N201-NUMERIC"
  46. 470  DATA  "D1510042A002-ALPHA  "
  47. 480  DATA  "D1710062D003-DATE  (MMDDYY)"
  48. 490  DATA  "SCREEN#0112"
  49. 500  DATA  "H0200TEST SCREEN # 1"
  50. 510  DATA  "H0400PERSONAL PROFILE"
  51. 520  DATA  "D0705251C001-NAME"
  52. 530  DATA  "D0805252C002-ADD1"
  53. 540  DATA  "D0905252C003-ADD2"
  54. 550  DATA  "D1005252C004-ADD3"
  55. 560  DATA  "D1105052N005-ZIP "
  56. 570  DATA  "D1705081N006-PHONE"
  57. 580  DATA  "D1905112N007-SS # "
  58. 590  DATA  "D2105062D008-DOB  "
  59. 600  DATA  "D1728011A009-SEX"
  60. 610  DATA  "D1928011A010-M/S"
  61. 620  DATA  "SCREEN#1004"
  62. 630  DATA  "H1000DECIMAL TEST SCREEN"
  63. 640  DATA  "D1510062N201-NUMERIC"
  64. 650  DATA  "D1710082N402-N 4 D   "
  65. 660  DATA  "D1910082N003-N O D   "
  66. 670  DATA  "END-OF-DATA"
  67. 60000  HOME : RESTORE : FOR Z2 = 1 TO 25:ZQ$(Z2) = "": NEXT Z2:ZP = 0
  68. 60002  READ ZA$(1)
  69. 60004  IF ZA$(1) = "END-OF-DATA"  THEN  GOTO 60138
  70. 60006  IF  LEFT$(ZA$(1),9) < >ZB$  THEN 60002
  71. 60008 ZC =  VAL( RIGHT$(ZA$(1),2))
  72. 60010  FOR Z = 1 TO ZC
  73. 60012  READ ZA$(Z)
  74. 60014 ZD(Z) =  VAL( MID$ (ZA$(Z),2,2))
  75. 60016 ZE(Z) =  VAL( MID$ (ZA$(Z),4,2))
  76. 60018 ZF$(Z) =  LEFT$(ZA$(Z),1)
  77. 60020  IF ZF$(Z) = "D"  THEN 60032
  78. 60022 ZG =  LEN(ZA$(Z)) -5
  79. 60024 ZH$(Z) =  RIGHT$(ZA$(Z),ZG)
  80. 60026  IF ZE(Z) = 0  THEN ZE(Z) =  INT(40 -ZG)/2
  81. 60028  VTAB ZD(Z): HTAB ZE(Z): PRINT ZH$(Z)
  82. 60030  GOTO 60044
  83. 60032 ZI(Z) =  VAL( MID$ (ZA$(Z),6,2))
  84. 60034 ZJ(Z) =  VAL( MID$ (ZA$(Z),8,1))
  85. 60036 ZK$(Z) =  MID$ (ZA$(Z),9,1)
  86. 60038 ZX(Z) =  VAL( MID$ (ZA$(Z),10,1))
  87. 60040 ZW$(Z) =  MID$ (ZA$(Z),11,2)
  88. 60042  GOSUB 60180
  89. 60044  NEXT Z
  90. 60046 Z1 = 1
  91. 60048  FOR Z = 1 TO ZC
  92. 60050  IF ZU < >1  THEN 60060
  93. 60052  IF ZF$(Z) = "H"  THEN 60120
  94. 60054  IF ZV < > VAL(ZW$(Z))  THEN Z1 = Z1 +1
  95. 60056  IF ZV < > VAL(ZW$(Z))  THEN 60120
  96. 60058  IF ZU = 1  AND ZV < > VAL(ZW$(Z))  THEN 60120
  97. 60060  IF ZF$(Z) = "H"  THEN 60120
  98. 60062  IF ZU = 1  AND ZV =  VAL(ZW$(Z))  THEN ZQ$(Z1) = ""
  99. 60064  FOR Z2 = 1 TO ZI(Z)
  100. 60066 ZG =  LEN(ZA$(Z)) -10
  101. 60068  VTAB ZD(Z): HTAB (ZE(Z) +1 +Z2 +ZG): GET ZL$: PRINT ZL$;
  102. 60070 ZM =  ASC(ZL$): IF ZJ(Z) < >1  AND ZM = 32  AND Z2 = 1  THEN Z1 = Z1 +1
  103. 60072  IF ZJ(Z) < >1  AND ZM = 32  AND Z2 = 1  THEN  GOTO 60120
  104. 60074  IF ZM = 27  THEN  GOSUB 60178: RESTORE : GOTO 60002
  105. 60076  IF ZK$(Z) < >"D"  AND Z2 < >1  AND ZM = 13  THEN  GOTO 60112
  106. 60078  IF ZM < >8  THEN 60090
  107. 60080  IF Z2 = 1  THEN  GOTO 60068
  108. 60082 Z2 = Z2 -1:ZO =  LEN(ZN$)
  109. 60084  IF Z2 = 1  THEN ZN$ = ""
  110. 60086  IF Z2 >1  THEN ZN$ =  LEFT$(ZN$,ZO -1)
  111. 60088  GOTO 60068
  112. 60090 ZP = 0: IF ZK$(Z) = "N"  OR ZK$(Z) = "D"  THEN  GOSUB 60140
  113. 60092  IF ZK$(Z) = "A"  THEN  GOSUB 60146
  114. 60094  IF ZK$(Z) = "C"  THEN  GOSUB 60150
  115. 60096  IF ZP < >0  THEN  GOSUB 60160
  116. 60098  IF ZP < >0 GOTO 60068
  117. 60100 ZN$ = ZN$ +ZL$: IF ZK$(Z) = "D"  THEN  GOSUB 60154
  118. 60102  IF ZP = 0  THEN  GOTO 60110
  119. 60104  GOSUB 60160:ZO =  LEN(ZN$): IF Z2 < = 2  THEN ZN$ = ""
  120. 60106  IF Z2 >2  THEN ZN$ =  LEFT$(ZN$,ZO -2)
  121. 60108 Z2 = Z2 -1: GOTO 60068
  122. 60110  NEXT Z2: PRINT 
  123. 60112  IF ZK$(Z) = "N"  THEN  GOSUB 60188
  124. 60114 ZQ$(Z1) = ZN$:Z1 = Z1 +1
  125. 60116 ZN$ = ""
  126. 60118  IF ZU = 1  THEN  GOTO 60124
  127. 60120  NEXT Z
  128. 60122  PRINT 
  129. 60124 ZU = 0: VTAB 23: CALL  -868: INPUT "OPT: FLD CHG#, R)ENTER, OR E)XIT ?";ZT$: IF ZT$ = "E"  THEN  RETURN 
  130. 60126  IF ZT$ = "R"  THEN  GOSUB 60178: RESTORE : GOTO 60002
  131. 60128  FOR Z1 = 1TPZC: IF ZF$(Z1) < >"D"  OR ZT$ < >ZW$(Z1)  THEN 60132
  132. 60130 ZL$ = "":ZN$ = "":ZU = 1:ZV =  VAL(ZW$(Z1)):Z = Z1: GOSUB 60180: GOTO 60046
  133. 60132  NEXT Z1
  134. 60134  VTAB 23: CALL  -868: PRINT "INVALID OPTION": FOR Z3 = 1 TO 1000: NEXT Z3: GOTO 60124
  135. 60136  RETURN 
  136. 60138  VTAB 23: CALL  -868: HTAB 10: PRINT "INVALID SCREEN NUMBER": FOR Z3 = 1 TO 1000: NEXT Z3: NORMAL :ZP = 1: RETURN 
  137. 60140 ZM =  ASC(ZL$): IF ZM = 47  THEN 60144
  138. 60142  IF ZM > = 45  AND ZM < = 57  THEN  RETURN 
  139. 60144 ZP = 1:ZR$ = "NON-NUMERIC": RETURN 
  140. 60146 ZM =  ASC(ZL$): IF ZM > = 65  AND ZM < = 90  THEN  RETURN 
  141. 60148 ZP = 1:ZR$ = "NON-ALPHA": RETURN 
  142. 60150 ZM =  ASC(ZL$): IF ZM > = 32  AND ZM < = 90  THEN  RETURN 
  143. 60152 ZP = 1:ZR$ = "NON-CHAR.": RETURN 
  144. 60154 ZM =  ASC(ZL$)
  145. 60156  ON Z2 GOSUB 60162,60164,60162,60170,60162,60174
  146. 60158  RETURN 
  147. 60160  VTAB 23: HTAB 15: FLASH : PRINT ZR$: FOR Z3 = 1 TO 1000: NEXT Z3: NORMAL : VTAB 23: CALL  -868: RETURN 
  148. 60162  RETURN 
  149. 60164 ZS =  VAL( LEFT$(ZN$,2))
  150. 60166  IF ZS >0  AND ZS < = 12  THEN  RETURN 
  151. 60168 ZP = 1:ZR$ = "INVALID DATE": RETURN 
  152. 60170 ZS =  VAL( RIGHT$(ZN$,2)): IF ZS >0  AND ZS < = 31  THEN  RETURN 
  153. 60172 ZP = 1:ZR$ = "INVALID DATE": RETURN 
  154. 60174 ZS =  VAL( RIGHT$(ZN$,2)): IF ZS > = 0  AND ZS < = 99  THEN  RETURN 
  155. 60176 ZP = 1:ZR$ = "INVALID DATE": RETURN 
  156. 60178  FOR Z1 = 1 TO 25:ZQ$(Z1) = "": NEXT Z1:ZL$ = "":ZN$ = "":ZU = 0: RETURN 
  157. 60180 ZG =  LEN(ZA$(Z)) -10
  158. 60182 ZH$(Z) =  RIGHT$(ZA$(Z),ZG)
  159. 60184  VTAB ZD(Z): HTAB ZE(Z): PRINT ZH$(Z);
  160. 60186  FOR Z2 = 1 TO ZI(Z): HTAB (ZE(Z) +ZG +1 +Z2): PRINT  CHR$(95);: NEXT Z2: PRINT : RETURN 
  161. 60188 ZG$ = "000000":ZG =  LEN(ZN$)
  162. 60190  FOR Z2 = 1 TO ZG
  163. 60192  IF  MID$ (ZN$,Z2,1) < >"."  THEN 60202
  164. 60194  IF ZX(Z) = 0  THEN ZN$ =  LEFT$(ZN$,Z2)
  165. 60196  IF ZX(Z) = 0  THEN  GOTO 60200
  166. 60198 ZN$ = ZN$ + LEFT$(ZG$,ZX(Z)):ZN$ =  LEFT$(ZN$,Z2 +ZX(Z))
  167. 60200 Z2 = ZG: GOTO 60208
  168. 60202  NEXT Z2
  169. 60204  IF ZX(Z) = 0  THEN 60208
  170. 60206 ZN$ = ZN$ +"." + LEFT$(ZG$,ZX(Z))
  171. 60208  RETURN